home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / back_end / m68emit.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  5.1 KB  |  156 lines
  1. (herald m68emit)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.               
  26. (define (generate-move ref1 ref2)
  27.   (if (neq? ref1 ref2)
  28.       (if (and (pair? ref1) (null? (cdr ref1)))
  29.           (generate-move-address (car ref1) ref2)
  30.           (emit m68/move .l ref1 ref2))))
  31.  
  32. (define-integrable (generate-move-word ref1 ref2)
  33.   (if (neq? ref1 ref2)
  34.       (emit m68/move .w ref1 ref2)))
  35.  
  36. (define-integrable (generate-move-byte ref1 ref2)
  37.   (if (neq? ref1 ref2)
  38.       (emit m68/move .b ref1 ref2)))
  39.  
  40. (define (generate-push access)
  41.   (increment-stack)
  42.   (if (and (pair? access) (null? (cdr access)))
  43.       (emit m68/pea (car access))
  44.       (emit m68/move .l access (@-r 15))))
  45.  
  46. (define-integrable (generate-pop access)
  47.   (emit m68/move .l (@r+ 15) access))
  48.  
  49.  
  50. (define (adjust-stack-pointer n)
  51.   (if (fxn= n 0) (emit m68/lea (d@r 15 n) SP)))
  52.  
  53.                                      
  54. (define (generate-move-address from to)
  55.   (cond ((register? to)
  56.          (if (or (atom? from)
  57.                  (neq? (car from) to)
  58.                  (neq? (cdr from) 0))
  59.              (emit m68/lea from to)))
  60.         ((locked? AN)
  61.          (emit m68/pea from)
  62.          (generate-pop to))
  63.         (else
  64.          (emit m68/lea from AN)
  65.          (emit m68/move .l AN to))))
  66.                
  67. (define-integrable (generate-slink-jump offset)
  68.   (emit m68/jsr (*d@nil offset)))
  69.  
  70.  
  71. (define-integrable (generate-jump-to-subroutine fg)
  72.   (emit m68/jsr fg))
  73.                    
  74. (define-integrable (generate-jump-absolute fg)
  75.   (emit m68/jmp fg))
  76.                    
  77. (define-integrable (generate-jump label)
  78.   (emit-jump 'jmp label nil))
  79.  
  80. (define-integrable (generate-avoid-jump label)
  81.   (emit-avoid-jump 'jmp label nil))
  82.  
  83. (define (generate-return n-args)               
  84.   (emit m68/move .l (machine-num (fx- -1 n-args)) NARGS)
  85.   (emit m68/move .l (@r 15) TP)
  86.   (emit m68/jmp (@r 13)))
  87.  
  88. (define (generate-return-without-nargs)
  89.   (emit m68/move .l (@r 15) TP)
  90.   (emit m68/jmp (@r 13)))
  91.  
  92.  
  93. (define (generate-general-call proc-var n-args)
  94.   (emit m68/move .l  (machine-num (fx+ n-args 1)) NARGS)
  95.   (cond ((and (or (variable-binder proc-var)
  96.           (var-is-vcell? proc-var)))
  97.      (emit m68/jmp (*d@nil slink/icall)))
  98.     (else
  99.          (emit m68/move .l (reg-offset P -2) TP)
  100.          (emit m68/jmp (@r 13)))))
  101.  
  102.     
  103. (define-integrable (generate-push-address access)
  104.   (increment-stack)
  105.   (emit m68/pea access))
  106.  
  107.       
  108. (define-integrable (increment-stack)
  109.   (set *stack-pos* (fx+ *stack-pos* CELL)))
  110.  
  111. (define-integrable (n-decrement-stack n)
  112.   (set *stack-pos* (fx- *stack-pos* (fx* n CELL))))
  113.  
  114. (define (emit op . args)
  115.   (m68emit (apply op (map! ->field-group args))))
  116.  
  117.  
  118. (define (indexer address offset data)
  119.   (cons (cons address data) offset))
  120.  
  121. (define (->field-group operand)
  122.   (cond ((fg? operand) operand)
  123.         ((fixnum? operand)
  124.          (register->field-group operand))
  125.         ((atom? operand) operand)
  126.         ((fg? (car operand)) operand)
  127.         ((fixnum? (car operand))
  128.          (d@r (symbolic->machine-reg (car operand)) (cdr operand)))
  129.         (else
  130.          (index (d@r (symbolic->machine-reg (caar operand)) (cdr operand))
  131.                 (symbolic->machine-reg (cdar operand))))))
  132.  
  133. (define (symbolic->machine-reg reg)
  134.   (cond ((fx< reg 0)
  135.          (vref *reserved-registers* (fx- 0 reg)))
  136.         ((fx>= reg 6) (fx+ reg 2))
  137.         (else reg)))
  138.  
  139. (define (register->field-group reg)
  140.   (cond ((fx< reg 0)
  141.          (r (vref *reserved-registers* (fx- 0 reg))))
  142.         ((fx< reg 6)
  143.          (r reg))   
  144.         ((fx< reg *real-registers*)
  145.          (r (fx+ reg 2)))
  146.         (else
  147.          (d@r 14 (fx* (fx- reg *real-registers*) CELL)))))
  148.  
  149.  
  150. (define *reserved-registers*
  151.   '#(nil 13 7   15 14    6))
  152. ;        TP nil SP TASK SCRATCH
  153.  
  154.  
  155. (define (emit-hacked-branch jump-op displ)
  156.   (%emit m68/hack-jbcc (jump-op->m68-cc jump-op) displ))